perm filename FRONT.MLI[4,KMC] blob
sn#178065 filedate 1975-09-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 BEGIN
C00007 00003 % INIT_DICTIO reads in:
C00009 00004 % MARK reads file of atoms and marks each with filename. %
C00011 00005 % STORE_IDIOM stores idiom (or suffix) under first word (or letter) in it. %
C00013 00006 % GET_CHUCK is interface to Chuck's FAIL table lookup routines %
C00015 00007 % OPEN_DISK opens appropriate disk files depending on situation. %
C00018 00008 % GET_QUESTION returns a list of the words typed in, with punctuation
C00021 00009 % FIND_WORDS accepts a list of words and returns a list of the words in
C00025 00010 % RE_SPELL drops one letter (covers double letter, extra letter, & 7 for ').
C00028 00011 % LEARN asks the TTY for the definition of new words and records them.
C00030 00012 % CANONIZE accepts a list of words and returns a list of the words which
C00033 00013 % SEGMENT segments a list of words into a list of segments, each of
C00036 00014 % TRANSLATE produces the pattern matching the input %
C00039 00015 % ANAPH_REF gets an anaphoric reference for a pronoun %
C00041 00016 % DE_FILL removes non-vital (filler) patterns from list %
C00043 00017 % Dummy WINDOW function when CHUCK'S aren't available. %
C00045 00018 % CYCLE allows re-entering the cycle after errors. %
C00048 00019 % RUN does the bookkeeping and cycles through the I/O sequence. %
C00049 ENDMK
C⊗;
BEGIN
SPECIAL NEXT_CHAR, LEARNING, RIGHT, USE_CHUCK, USE_BILL,
SSENT, ANY, INPUTQUES, PATTERN, SP_MATCH, CP_MATCH, STOP_ON,
NOT_FLAG, FAMILY_FLAG, DOC_NAME_FLAG,
DO_SPELL, DID_SPELL, MISSPELLED, GIBBERISH, WINDOWS;
% Initialization without starting main program %
EXPR PMINITIALIZE();
BEGIN
GCGAG(T);
USE_CHUCK ← GET_INP("Have you run SETUP and loaded PARFNS");
INIT_CHAR();
INIT_DICTIO();
USE_BILL ← GET_INP("Is the memory available");
IF USE_CHUCK AND ¬USE_BILL THEN ROGER();
OPEN_DISK();
WINDOWS ← NIL;
NEXT_CHAR ← BLANK;
PRINTSTR("Type any readable English sentence followed by a <CR>.");
PRINTSTR("A session is terminated with GOOD BYE.");
END;
% INIT_CHAR determines treatment of special characters
and indicates which keys are near each other for the speller %
EXPR INIT_CHAR();
BEGIN
NEW TERMINAL, DELIMITER, ACTIVATE;
TERMINAL ← <'?!, PERCENT, RPAR, PERIOD, '??, RSBR>;
FOR NEW I IN TERMINAL DO PUTPROP(I, T, 'PERIOD);
DELIMITER ← <COMMA, COLON, SEMICOLON>;
FOR NEW I IN DELIMITER DO PUTPROP(I, T, 'COMMA);
ACTIVATE ← <CR, ALTMODE>;
FOR NEW I IN ACTIVATE DO PUTPROP(I, T, 'CR);
FOR NEW I IN <CR, BLANK, COMMA, PERIOD> DO PUTPROP(I, T, 'STOP);
EQUATE('(NEARBY.KEY), T);
DO_SPELL ← T;
DID_SPELL ← NIL;
MISSPELLED ← GIBBERISH ← 0;
END;
% INIT_DICTIO reads in:
STARTR.ALF Words which start fragments
STOPPR.ALF Words which stop fragments
FLAGS.ALF Words with special functions
SYNONM.ALF Words recognized and synonyms
IRREG.ALF Irregular verbs, known misspellings and contractions
SUFFIX.ALF Word suffixes
IDIOM.ALF Idiomatic substitutions
SPATS.SEL Simple sentence patterns
CPATS.SEL Compound sentence patterns
FILLER.PAT Non-vital patterns
NEGATE.PAT Patterns with opposite meanings
DAD.PAT Patterns specific to father
MOM.PAT Patterns specific to mother
FAMLY.PAT Patterns referring to family %
EXPR INIT_DICTIO();
BEGIN
MARK('(STARTR.ALF));
MARK('(STOPPR.ALF));
MARK('(FLAGS.ALF));
SET_VAL('IRREG);
STORE_IDIOM('SUFFIX);
STORE_IDIOM('IDIOM);
IF USE_CHUCK THEN NIL
ELSE BEGIN
SET_VAL('SYNONM);
STORE_PAT('SPATS, 'SPNUM);
STORE_PAT('CPATS, 'CPNUM);
END;
MARK('(FILLER.PAT));
EQUATE('(NEGATE.PAT), NIL);
FOR NEW FAM IN '(DAD MOM FAMLY) DO
EQUATE(FAM CONS 'PAT, NIL);
INC(NIL, T);
END;
% MARK reads file of atoms and marks each with filename. %
EXPR MARK(FILE);
BEGIN
NEW WORD;
EVAL <'INPUT, '(PAR RCP), FILE>;
INC(T,T);
WHILE ¬ATOM(WORD ← ERRSET(READ())) DO
PUTPROP(CAR WORD, T, CAR FILE);
END;
% Reads file of lists and stores CDR as value of CAR. %
EXPR SET_VAL(FILE);
BEGIN
NEW PAIR;
EVAL <'INPUT, '(PAR RCP), (FILE CONS 'ALF)>;
INC(T,T);
WHILE ¬ATOM(PAIR ← ERRSET(READ())) DO
PUTPROP(CAAR PAIR, CDAR PAIR, FILE);
END;
% Reads file of lists and stores list[2] as value of list[1]. %
EXPR EQUATE(FILE, BOTH);
BEGIN
NEW PAIR;
EVAL <'INPUT, '(PAR RCP), FILE>;
INC(T,T);
WHILE ¬ATOM(PAIR ← ERRSET(READ())) DO
BEGIN
PUTPROP(PAIR[1,1], PAIR[1,2], CAR FILE);
IF BOTH THEN PUTPROP(PAIR[1,2], PAIR[1,1], CAR FILE);
END;
END;
% STORE_IDIOM stores idiom (or suffix) under first word (or letter) in it. %
EXPR STORE_IDIOM(FILE);
BEGIN
NEW LINE;
EVAL <'INPUT, '(PAR RCP), (FILE CONS 'ALF)>;
INC(T,T);
WHILE ¬ATOM(LINE ← ERRSET(READ())) DO
BEGIN
IF FILE EQ 'IDIOM THEN LINE ← CAR LINE
ELSE LINE ← (REVERSE EXPLODE CAAR LINE) CONS CDAR LINE;
ADDPROP(CAAR LINE, CDAR LINE CONS (LENGTH CDAR LINE) CONS
CDR LINE, FILE);
END;
END;
% Reads pattern and λ number and stores each as value of other. %
EXPR STORE_PAT(FILE, INVERS);
BEGIN
NEW PAIR;
EVAL <'INPUT, '(PAR RCP), (FILE CONS 'SEL)>;
INC(T, T);
WHILE ¬ATOM(PAIR ← ERRSET(READ())) DO
BEGIN
PUTPROP(AT PAIR[1,1], PAIR[1,2], INVERS);
ADDPROP(PAIR[1,2], PAIR[1,1], FILE);
END;
END;
% Non-destructive PUTPROP. %
EXPR ADDPROP(ATM, VAL, PROP);
PUTPROP(ATM, VAL CONS GET(ATM, PROP), PROP);
% GET_CHUCK is interface to Chuck's FAIL table lookup routines %
EXPR GET_CHUCK(ATM, PROP);
BEGIN
NEW MEANING;
RETURN(
IF PROP EQ 'SYNONM THEN
IF (USE_CHUCK AND (MEANING ← SYNNYM(WINDOW(12,T,ATM)))) THEN MEANING
ELSE GET(ATM, PROP)
ELSE IF PROP EQ 'IRREG THEN GET(WINDOW(12, T, ATM), PROP)
ELSE IF PROP EQ 'SPELL THEN
PROG2(ATM ← READLIST ATM,
IF GET_CHUCK(ATM,'SYNONM) THEN NCONS ATM ELSE GET_CHUCK(ATM,'IRREG))
ELSE IF PROP EQ 'SPNUM THEN
PROG2(IF (MEANING ← IF USE_CHUCK THEN SPAT(WINDOW(17, T, ATM))
ELSE GET(AT ATM, PROP))
THEN SP_MATCH ← ATM CONS SP_MATCH, MEANING)
ELSE IF PROP EQ 'CPNUM THEN
PROG2(IF (MEANING ← IF USE_CHUCK THEN CPAT(WINDOW(17, T, ATM))
ELSE GET(AT ATM, PROP))
THEN CP_MATCH ← ATM, MEANING)
ELSE IF PROP EQ 'SPATS THEN
IF USE_CHUCK THEN STHGHT(ATM)
ELSE GET(ATM, PROP)
ELSE IF PROP EQ 'CPATS THEN
IF USE_CHUCK THEN CTHGHT(ATM)
ELSE GET(ATM, PROP)
ELSE PRINTSTR("Invalid call on GET_CHUCK"));
END;
% OPEN_DISK opens appropriate disk files depending on situation. %
EXPR OPEN_DISK();
BEGIN
NEW DISK_INP, START_ON;
DISK_INP ← GET_INP("Disk input file =");
IF DISK_INP THEN
BEGIN
EVAL <'INPUT, 'DISK_INP, '(ENG KMC), DISK_INP>;
INC('DISK_INP, NIL);
IF (START_ON ← GET_INP("Start on what λ#")) THEN READUPTO(START_ON);
STOP_ON ← GET_INP("Stop on what λ#");
END
ELSE STOP_ON ← '?λ0045;
LEARNING ← GET_INP("Learning mode =");
IF LEARNING EQ 'SYNONM THEN
EVAL '(OUTPUT NEWSYN (PAR RCP) (SYNONM.NEW))
ELSE IF LEARNING EQ 'SPATS THEN
EVAL '(OUTPUT NEWSP (PAR RCP) (SPATS.INT))
ELSE IF LEARNING EQ 'CPATS THEN
EVAL '(OUTPUT NEWCP (PAR RCP) (CPATS.INT))
ELSE IF LEARNING THEN EVAL '(OUTPUT NEWSEN (HMF RCP) REDO)
ELSE IF ¬USE_BILL THEN EVAL <'OUTPUT, 'RECORD, '(HMF RCP),
((IF DISK_INP THEN DISK_INP ELSE 'RECORD) CONS 'ANS)>;
END;
% Skips some disk records and then looks for indicated starting number.
There are about 20 sentences per disk record. %
EXPR READUPTO(NUM);
BEGIN
NEW A, B;
A ← GET_INP("Guess for disk record #");
IF A AND NUMBERP A THEN USETI('DISK_INP, A);
WHILE ATOM B DO B ← READ();
WHILE (A ← CHSETI('DISK_INP, NIL)) AND (CAR B NEQ NUM) DO B ← READ();
CHSETI('DISK_INP, A); % Backspace over last S-EXPR %
PRINTSTR("True record number was " CAT USETI('DISK_INP, NIL));
END;
EXPR CLOSE_DISK();
BEGIN
IF LEARNING EQ 'SYNONM THEN OUTC('NEWSYN, NIL)
ELSE IF LEARNING EQ 'SPATS THEN OUTC('NEWSP, NIL)
ELSE IF LEARNING EQ 'CPATS THEN OUTC('NEWCP, NIL)
ELSE IF LEARNING THEN OUTC('NEWSEN, NIL)
ELSE IF ¬USE_BILL THEN OUTC('RECORD, NIL);
OUTC(NIL, T);
INC(NIL, T);
END;
% GET_QUESTION returns a list of the words typed in, with punctuation
replaced by words. NEXT_CHAR ≠ CR means more input on line. %
EXPR GET_QUESTION();
BEGIN
NEW WORD;
RETURN( IF (WORD ← READ_TOKEN()) EQ PERIOD THEN '(PD)
ELSE IF WORD EQ COMMA THEN ('COMMA CONS GET_QUESTION())
ELSE (WORD CONS GET_QUESTION()));
END;
% READ_TOKEN returns the next word or special character typed in. %
EXPR READ_TOKEN();
BEGIN
NEW WORD;
WHILE NEXT_CHAR MEMQ <BLANK, CR> DO NEXT_CHAR ← READ_CLEAN();
IF NUMBERP NEXT_CHAR THEN WORD ← <ASCII(35)>;
WHILE ¬GET_SAFE(NEXT_CHAR, 'STOP) DO
BEGIN
WORD ← NEXT_CHAR CONS WORD;
NEXT_CHAR ← READ_CLEAN();
END;
IF WORD THEN RETURN READLIST REVERSE WORD
ELSE IF (WORD ← NEXT_CHAR) EQ COMMA THEN NEXT_CHAR ← READ_CLEAN()
ELSE % NEXT_CHAR EQ PERIOD so throw out trash %
WHILE GET_SAFE(NEXT_CHAR, 'STOP) AND (NEXT_CHAR NEQ CR) DO
NEXT_CHAR ← READ_CLEAN();
RETURN WORD;
END;
% READCH with lower case conversion and trash converted to blanks. %
EXPR READ_CLEAN();
BEGIN
NEW CHAR, VAL;
IF NUMBERP (CHAR ← READCH()) THEN RETURN CHAR
ELSE VAL ← CHRVAL(CHAR);
RETURN(
IF (VAL ≥ 65 AND VAL ≤ 90) OR VAL = 39 THEN CHAR
ELSE IF VAL ≥ 97 AND VAL ≤ 122 THEN ASCII(VAL - 32)
ELSE IF GET(CHAR, 'COMMA) THEN COMMA
ELSE IF GET(CHAR, 'PERIOD) THEN PERIOD
ELSE IF GET(CHAR, 'CR) THEN CR
ELSE IF VAL = 8 AND LEARNING THEN CHAR
ELSE BLANK);
END;
% GET with no properties on numbers. %
EXPR GET_SAFE(WORD, PROP);
IF NUMBERP WORD THEN NIL ELSE GET(WORD, PROP);
% FIND_WORDS accepts a list of words and returns a list of the words in
the present or singular with the spelling fixed. %
EXPR FIND_WORDS(SENT);
FOR NEW WORD IN SENT COLLECT
BEGIN
NEW MEANS;
IF ¬(MEANS ← WINDOW(3, NIL, FIND_WORD(WINDOW(11, T, WORD))))
THEN GIBBERISH ← GIBBERISH + 1
ELSE IF DID_SPELL THEN MISSPELLED ← MISSPELLED + 1
ALSO DID_SPELL ← NIL;
RETURN MEANS;
END;
EXPR FIND_WORD(WORD);
BEGIN
NEW MEANS;
IF GET_CHUCK(WORD, 'SYNONM) THEN MEANS ← NCONS WORD
ELSE IF (MEANS ← GET_CHUCK(WORD, 'IRREG)) OR
(MEANS ← DE_SUFFIX(WORD)) OR
(MEANS ← RE_SPELL(WORD)) THEN NIL
ELSE IF LEARNING EQ 'SYNONM THEN MEANS ← LEARN(WORD);
RETURN(MEANS);
END;
% DE_SUFFIX will accept a word and return the root word in a list. %
% Should count all misspellings. Suffixer ignores misspelling. %
EXPR DE_SUFFIX(WORD);
BEGIN
NEW ROOT, LEN, WORDEX;
WORDEX ← EXPLODE(WORD);
IF CHRVAL(CAR WORDEX) = 35 THEN ROOT ← '(NUMBER)
ELSE IF (LEN ← LENGTH WORDEX) ≤ 3 OR LEN ≥ 20 THEN NIL
ELSE IF ROOT ← GET(CAR(WORDEX ← REVERSE WORDEX), 'SUFFIX) THEN
ROOT ← ROOT_VAL(CDR WORDEX, ROOT);
DID_SPELL ← NIL;
IF ROOT ∧ LEARNING EQ 'SYNONM ∧ ¬GET(WORD, 'SUF) THEN
IF GET_INP("Is " CAT WORD CAT " like " CAT ROOT)
THEN PUTPROP(WORD, T, 'SUF)
ELSE ROOT ← NIL;
RETURN ROOT;
END;
% ROOT_VAL returns a root word (in a list) if one of the suffixes can be removed. %
% Should note occurrence of past tense verbs. %
EXPR ROOT_VAL(WORDR, SUFS);
IF ¬SUFS THEN NIL
ELSE IF CAAR SUFS = (WORDR ↑ CADAR SUFS) THEN
BEGIN
NEW MEANS;
WORDR ← (WORDR ↓ CADAR SUFS);
IF ¬WORDR THEN NIL
ELSE IF (CAR WORDR EQ 'I) AND
(MEANS ← FIND_WORD(READLIST REVERSE('Y CONS CDR WORDR))) OR
(MEANS ← FIND_WORD(READLIST REVERSE('E CONS WORDR))) OR
(MEANS ← FIND_WORD(READLIST REVERSE WORDR)) THEN
MEANS ← MEANS APPEND CDDAR SUFS;
RETURN MEANS;
END
ELSE ROOT_VAL(WORDR, CDR SUFS);
% RE_SPELL drops one letter (covers double letter, extra letter, & 7 for ').
Drops from R to L instead of L to R. Takes E at end first.
Returns meaning in present, singular, correctly spelled. %
EXPR RE_SPELL(WORD);
IF DO_SPELL THEN
BEGIN
NEW MEANS, WORDEX;
IF LENGTH(WORDEX ← EXPLODE(WORD)) ≥ 15 OR
¬(CDR WORDEX) OR (NUMBERP CADR WORDEX) THEN NIL
ELSE IF (MEANS ← DROP_ONE_REV(NIL, REVERSE WORDEX, 'SPELL)) OR
(MEANS ← NEXT_KEY(NIL, WORDEX)) OR
(MEANS ← TRANSPOSE(NIL, WORDEX)) THEN DID_SPELL ← T;
IF MEANS ∧ LEARNING EQ 'SYNONM ∧ ¬GET(WORD, 'RES) THEN
IF GET_INP("Does " CAT WORD CAT " spell " CAT MEANS)
THEN PUTPROP(WORD, T, 'RES)
ELSE MEANS ← NIL;
RETURN MEANS;
END;
% Replace by letter nearby on keyboard. %
% Should think 0 is near O. %
EXPR NEXT_KEY(HEAD, TAIL);
BEGIN
NEW CAND;
RETURN(
IF ¬TAIL THEN NIL
ELSE IF (CAND ← GET_SAFE(CAR TAIL, 'NEARBY)) AND
(CAND ← GET_CHUCK(HEAD @ (CAND CONS CDR TAIL), 'SPELL))
THEN CAND
ELSE NEXT_KEY(HEAD @ <CAR TAIL>, CDR TAIL));
END;
% Transpose letters in word %
EXPR TRANSPOSE(HEAD, TAIL);
BEGIN
NEW CAND;
RETURN(
IF ¬CDR TAIL THEN NIL
ELSE IF CAND ← GET_CHUCK(
HEAD @ (CADR TAIL CONS CAR TAIL CONS CDDR TAIL), 'SPELL)
THEN CAND
ELSE TRANSPOSE(HEAD @ <CAR TAIL>, CDR TAIL));
END;
% LEARN asks the TTY for the definition of new words and records them.
Only called if LEARNING = SYNONM %
EXPR LEARN(WORD);
BEGIN
NEW MEANS;
IF GET(WORD, 'LEA) THEN RETURN NIL;
MEANS ← GET_INP("What is " CAT WORD);
IF ¬MEANS THEN PUTPROP(WORD, T, 'LEA)
ALSO RETURN NIL
ELSE IF ATOM MEANS THEN WHILE ¬(MEANS ← GET_CHUCK(MEANS, 'SYNONM)) DO
MEANS ← GET_INP("Try again " CAT WORD);
OUTC('NEWSYN, NIL);
IF ATOM CAR MEANS THEN
BEGIN
PUTPROP(WORD, MEANS, 'SYNONM);
PRINT(WORD CONS MEANS);
END
ELSE BEGIN
ADDPROP(CAAR MEANS, CDAR MEANS CONS (LENGTH CDAR MEANS) CONS
CDR MEANS, 'IDIOM);
PRINT MEANS;
PUTPROP(CAAR MEANS, '(A), 'SYNONM);
PRINT<CAAR MEANS, 'A>;
END;
OUTC(NIL, NIL);
RETURN NCONS WORD;
END;
% GET_INP gets an input from the TTY. N is taken as NIL. %
EXPR GET_INP(QUESTION);
BEGIN
NEW CHAN, ANSWER;
PRINC(QUESTION CAT " ? ");
CHAN ← INC(NIL, NIL);
ANSWER ← READ();
INC(CHAN, NIL);
TERPRI NIL;
RETURN(IF ANSWER = 'N THEN NIL ELSE ANSWER);
END;
% Writes to any selected file. %
EXPR FPRINT(CHAN, L);
BEGIN
OUTC(CHAN, NIL);
PRINT L;
OUTC(NIL, NIL);
END;
% CANONIZE accepts a list of words and returns a list of the words which
the given words are (idiomatically) translated into. %
% Should be done entirely in FAIL. %
EXPR CANONIZE(SENT);
BEGIN
NEW CANIZED;
INPUTQUES ← NIL;
IF CAR SENT MEMQ '(EVER ANY) THEN CANIZED ← '(YOU);
WHILE SENT DO
BEGIN
NEW WORD, MEANS;
WORD ← CAR SENT;
WINDOW(13,T,WORD);
SENT ← CDR SENT;
ANY ← NIL;
IF (MEANS ← GET(WORD, 'IDIOM)) AND
(MEANS ← IDIOM_VAL(MEANS, SENT)) THEN
BEGIN
WINDOW(14,T, CONS(WORD, CAR MEANS));
SENT ← (SENT ↓ CADR MEANS);
MEANS ← CDDR MEANS;
IF ANY THEN MEANS ←
SUBST(CAR GET_CHUCK(ANY, 'SYNONM), 'any, MEANS);
END
ELSE MEANS ← GET_CHUCK(WORD, 'SYNONM);
IF MEANS AND (MEANS ≠ '(A)) THEN
BEGIN
WINDOW(4,NIL,CAR MEANS);
CANIZED ← CANIZED APPEND MEANS;
INPUTQUES ← (CAR MEANS CONS WORD) CONS INPUTQUES;
END;
END;
INPUTQUES ← REVERSE INPUTQUES;
RETURN CANIZED;
END;
% IDIOM_VAL looks ahead to check for idioms which translate to single words. %
EXPR IDIOM_VAL(IDIOMS, SENT);
IF ¬IDIOMS THEN NIL
ELSE IF SAME(CAAR IDIOMS, (SENT ↑ CADAR IDIOMS)) THEN CAR IDIOMS
ELSE IDIOM_VAL(CDR IDIOMS, SENT);
% SAME accepts wild cards (i.e. 'any) which match 1 word of input.
The input word thus matched is saved in ANY. %
EXPR SAME(IDI, SEN);
(IDI = SEN) OR
SEN AND
((CAR IDI EQ CAR SEN) OR (CAR IDI EQ 'any) AND (ANY ← CAR SEN)) AND
SAME(CDR IDI, CDR SEN);
% SEGMENT segments a list of words into a list of segments, each of
which is a list of words. %
EXPR SEGMENT(L);
SEGMENT1(NIL,L);
% Helper for SEGMENT. %
% Maybe should not cut off single word after a STOPPR. %
EXPR SEGMENT1(S,R);
IF ¬R THEN <S>
ELSE IF GET(R[1], 'STOPPR) THEN
IF CDR R THEN (S @ <R[1]>) CONS SEGMENT(CDR R)
ELSE <S @ <R[1]>>
ELSE IF GET(R[1],'STARTR) THEN
IF S THEN (S CONS SEGMENT(R))
ELSE SEGMENT1(<R[1]>,CDR R)
ELSE SEGMENT1(S@<R[1]>,CDR R);
% WRITE_SP writes newly formed simple and compound patterns. %
EXPR WRITE_SP();
BEGIN
NEW COMPOUND, TO_PRINT, LAST_NEG;
COMPOUND ← LENGTH(PATTERN) ≥ 2;
OUTC('NEWSP, NIL);
FOR NEW PAT IN PATTERN DO
BEGIN
NEW REALLY, ANSWER;
NOT_FLAG ← FAMILY_FLAG ← NIL;
PAT ← DE_FLAG(PAT); % Bombs if input contains "THEY". %
IF PAT THEN ANSWER ← GET_CHUCK(PAT, 'SPNUM);
IF LAST_NEG AND ANSWER NEQ 'P0000 THEN NOT_FLAG ← ¬NOT_FLAG;
IF NOT_FLAG AND (REALLY ← GET(ANSWER, 'NEGATE))
THEN ANSWER ← REALLY;
IF FAMILY_FLAG AND ((REALLY ← GET(ANSWER, FAMILY_FLAG)) OR
(REALLY ← GET(ANSWER, 'FAMLY))) THEN ANSWER ← REALLY;
LAST_NEG ← ANSWER MEMQ '(?λ3150 P5245);
IF ¬(PAT OR ANSWER) THEN NIL
ELSE IF GET(ANSWER, 'FILLER) THEN
PRINT<PAT, NOT_FLAG, (FAMILY_FLAG OR NIL), COMPOUND, RIGHT>
ELSE TO_PRINT ← <PAT, NOT_FLAG, (FAMILY_FLAG OR NIL)> CONS TO_PRINT;
END;
COMPOUND ← LENGTH(TO_PRINT) ≥ 2;
FOR NEW PAT IN TO_PRINT DO PRINT(PAT @ <COMPOUND, RIGHT>);
OUTC(NIL, NIL);
END;
EXPR WRITE_CP();
FPRINT('NEWCP, <DE_FILL(FOR NEW SEG IN PATTERN COLLECT MATCH(SEG)), RIGHT>);
% TRANSLATE produces the pattern matching the input %
EXPR TRANSLATE(SENT);
BEGIN
NEW FIRST, MEANS, DEFIL;
FIRST ← FOR NEW SEG IN SENT COLLECT MATCH(WINDOW(16,T,SEG));
DOC_NAME_FLAG ← NIL;
IF ¬(DEFIL ← DE_FILL(FIRST)) THEN NIL
ELSE IF ¬(CDR DEFIL) THEN MEANS ← FIRST_LAMBDA(DEFIL)
ELSE IF (MEANS ← GET_CHUCK(DEFIL, 'CPNUM)) THEN NIL
ELSE IF ¬(CDDR DEFIL) THEN MEANS ← FIRST_LAMBDA(REVERSE DEFIL)
ELSE IF (MEANS ← DROP_ONE(NIL, DEFIL, 'CPNUM)) THEN NIL
ELSE MEANS ← FIRST_LAMBDA(REVERSE DEFIL);
IF ¬MEANS THEN MEANS ← FIRST_LAMBDA(REVERSE FIRST);
RETURN MEANS;
END;
% MATCH produces the simple pattern matching the input %
% Maybe should transpose words. Especially (YOU BE) ↔ (BE YOU) %
EXPR MATCH(SEG);
BEGIN
NEW ANSWER, REALLY;
NOT_FLAG ← FAMILY_FLAG ← NIL;
IF ¬(SEG ← DE_FLAG(SEG)) OR
(ANSWER ← GET_CHUCK(SEG, 'SPNUM)) OR
(ANSWER ← DROP_ONE(NIL, SEG, 'SPNUM)) THEN NIL;
IF NOT_FLAG AND (REALLY ← GET(ANSWER, 'NEGATE))
THEN ANSWER ← REALLY;
IF FAMILY_FLAG AND ((REALLY ← GET(ANSWER, FAMILY_FLAG)) OR
(REALLY ← GET(ANSWER, 'FAMLY))) THEN ANSWER ← REALLY;
RETURN(IF ¬ANSWER THEN NIL ELSE <ANSWER>);
END;
% DE_FLAG removes the special function words from a segment %
EXPR DE_FLAG(L);
BEGIN
NEW WORD;
RETURN(
IF ¬L THEN NIL
ELSE IF ¬GET((WORD ← CAR L), 'FLAGS) THEN WORD CONS DE_FLAG(CDR L)
ELSE IF WORD EQ 'THEY THEN
IF (WORD ← CAR ANAPH_REF(WORD)) MEMQ '(DAD MOM FAMLY) THEN
'YOU CONS DE_FLAG(WORD CONS CDR L)
ELSE DE_FLAG(WORD CONS CDR L)
ELSE IF WORD EQ 'NOT THEN NOT_FLAG ← ¬ NOT_FLAG
ALSO DE_FLAG(CDR L)
ELSE IF WORD MEMQ '(DAD MOM FAMLY) THEN FAMILY_FLAG ← WORD
ALSO DE_FLAG(CDR L)
ELSE DE_FLAG(CDR L));
END;
% ANAPH_REF gets an anaphoric reference for a pronoun %
EXPR ANAPH_REF(WORD);
BEGIN
NEW MEANS;
MEANS ← (IF USE_BILL THEN GET_ANAPH(WORD)
ELSE GET_INP("Anaphoric reference for " CAT WORD));
IF ¬MEANS THEN MEANS ← 'PEOPLE;
WINDOW(15, T, CDR ASSOC(WORD, INPUTQUES));
WINDOW(15, NIL, MEANS);
MEANS ← GET_CHUCK(CAR FIND_WORD(MEANS), 'SYNONM);
RETURN(IF MEANS THEN MEANS ELSE '(PEOPL));
END;
% Leaves out one element of input from left to right. %
EXPR DROP_ONE(HEAD, TAIL, TYPE);
BEGIN
NEW CAND;
RETURN(
IF ¬TAIL THEN NIL
ELSE IF CAND ← GET_CHUCK(HEAD @ CDR TAIL, TYPE) THEN CAND
ELSE DROP_ONE(HEAD @ <CAR TAIL>, CDR TAIL, TYPE));
END;
% Leaves out one element of input from right to left. %
EXPR DROP_ONE_REV(HEAD, TAIL, TYPE);
BEGIN
NEW CAND;
RETURN(
IF ¬TAIL THEN NIL
ELSE IF CAND ← GET_CHUCK(((REVERSE CDR TAIL) @ HEAD), TYPE) THEN CAND
ELSE DROP_ONE_REV(CAR TAIL CONS HEAD, CDR TAIL, TYPE));
END;
% DE_FILL removes non-vital (filler) patterns from list %
EXPR DE_FILL(L);
IF ¬L THEN NIL
ELSE IF ¬GET(CAR L, 'FILLER) THEN CAR L CONS DE_FILL(CDR L)
ELSE IF CAR L MEMQ '(?λ3150 P5245) THEN
IF (CDR L) AND GET(CADR L, 'NEGATE) AND CADR L NEQ 'P0000
THEN DE_FILL(GET(CADR L, 'NEGATE) CONS CDDR L) ELSE DE_FILL(CDR L)
ELSE IF CAR L EQ '?λ0630 THEN GET_NAME()
ALSO DE_FILL(CDR L)
ELSE DE_FILL(CDR L);
% GET_NAME digs the doctor's name out of SSENT. %
EXPR GET_NAME();
BEGIN
NEW NAME, WORD;
NAME ← SSENT;
DO BEGIN
WORD ← CAR NAME;
NAME ← CDR NAME;
END
UNTIL ¬NAME OR WORD MEMQ '(I?'M AM NAME CALL ME) AND
CAR NAME MEMQ '(DR DOCTOR CALLED IS ME AS);
IF ¬NAME THEN NIL
ELSE IF CAR NAME MEMQ '(DR DOCTOR) OR CAR(NAME ← CDR NAME) MEMQ '(DR DOCTOR)
THEN NAME ← <'DOCTOR, CADR NAME>
ELSE NAME ← NCONS CAR NAME;
DOC_NAME_FLAG ← IF NAME AND CAR LAST NAME NEQ 'PD THEN NAME ELSE T;
END;
% FIRST_LAMBDA returns the first λ# in a list of pattern numbers. %
EXPR FIRST_LAMBDA(L);
IF ¬L THEN NIL
ELSE IF CHRVAL(CAR L) EQ 8 THEN CAR L
ELSE FIRST_LAMBDA(CDR L);
% Dummy WINDOW function when CHUCK'S aren't available. %
EXPR WINDOW(NUM, FLAG, L);
BEGIN
IF WINDOWS EQ 'BILL THEN PRINT <NUM, L>;
RETURN L;
END;
EXPR WINDOWSET(N); N;
% Suggested output to windows. %
EXPR WINDOW_PRINT(FIXED, CANIZED, ANSWER);
IF WINDOWS THEN
BEGIN
PRINTSTR("***********************");
PRINTSTR("Input: " CAT SSENT);
PRINTSTR("Recognized: " CAT FIXED);
PRINTSTR("Canonized: " CAT CANIZED);
PRINTSTR("Segmented: " CAT PATTERN);
PRINTSTR("Simple pats: " CAT REVERSE SP_MATCH);
PRINTSTR("Compound pat: " CAT CP_MATCH);
PRINTSTR("Result: " CAT ANSWER);
TERPRI PRINTSTR("***********************");
END;
% CYCLE allows re-entering the cycle after errors. %
EXPR CYCLE(y?↑:Lb∃αR-~PbB
"R⊗JrA%α:- αNR⎇b>9∧"=α:Lal4(hQ∃αR-~PbB
"R⊗JrβK↔π'→β?;*βGW↔∨#'?9ε ;⊃β⊗+SWKw→β?;*βCπS&+K9βw+7 ↔∩q↓∀4Ph*⊗b¬⊃αR⊗≥ bBε%"⊗J9BIl4(L∩⊗≡&ph(&:-9αε:≥:⊗I1∧2&b⊗"aα∞εtJj⊗⊃Xh(&N≤*:Qαzα≡⊗PE
V⊗N$J>9!KX4(&<J:∩>=~⊗Q!
Il4(M:&:∩⎇9!E1¬!1↓
LrBVQ∩Il4(M:&:∩⎇9!I1¬!1αN≤*:Q%Xh(&&2α2⊗ε∀r&:≥¬""⊗9¬∩&≡""α⎇α∞
⊃αNN,rP&εe~=αN≤*:Qαzα∞∩I¬~N⊗:#X4(&<J:∩>:AE1α"a↓
J-~B⊗2d*⊃ %Xh(&~MB⊗⊃αzα~&:!B↑>J%→"NN,rQ%lhP&↑&t">]!~aαQ1∧2&b⊗"Il4(LJ→α2,
J:&t9α⊗Eα:Nf:|r5αRD*9αJ-"VJ9¬∩&≡"#X4(&<J:∩>:AE1α"a↓
∞ r>:&T) %lhP&∞εtJj⊗⊃¬yα∞εtz:&j*α~&b,!l4(M:&:∩⎇9!Q1¬!1α∞ r&j⊗"Il4(M:&:∩⎇9!E1¬!1↓
≤*≡6⊗u! %lhP&Bε%"⊗J9¬yαN⊗<j⊗:QD~ε:&T*⊃%lhP&↑&t">]!*aαQ1¬αεRR-∩9%lhP&&→∧b⊗εJtJ:≥α- ↓≡N∧
RMα$B⊗9α=∩&R∀E~A!$L
2N=¬∩⊗RV∀qαJ&<BP4(L*2N∃∧J→α2,
J:&t9α⊗Eα:∞Bε%→αR",qα↑JM"∀b∞αA%αεe~=αJ-"VJ9¬∩&≡"#X4(&≥b6ε$~!α⎇∧~@b6
"∞!αzα:&1Xh(&↑Lr∩>]C 1αQb↓
6ε$~! %Xh(&εu~↑⊗I¬yαRJ rN2ε$)αBε%"⊗J9Xh(&↑Lr∩>]C91αQbαJ⊗Z-∩N∃α≥b6ε$~!%lhP&↑&t">]!BaαQ1∧~@b6
"∞!%Xh(&&2⊗ε:≥:⊗Iα r⊃↓"d*:≡RBBNN⊗u!%qβ!%αRD*84(HJε:N<*Iα⎇∧J→α∞%⊃αNN,rQαRD*9↓≥xAAAEαα⊗2N*↓≥|!∪1AAlhP&↑&t">\b¬∩&:QD2&b⊗"aα∞εtJj⊗⊃bαε:N<*I%lhP&&→∧b⊗εJtJ:≥α$B⊗84PH&&→∧
:N↑-⊃α⊗E¬∩&≡""αR"⊗rα:&0hP$&⊗e~∃α~¬∩&:QB::⊗↑≤*91α rN↑⊗∩α∞>:~αJ&≡E!α∞>u→αNN,rQ$4PJ⊗2N*α&→-*N∀b∀J21α$B⊗84PH&
⊗<J84(HJBJ&u"NRI¬~N⊗:#X4($M"⊗JB∀IαBJLrRNR∩αε:N<*Il4PH&~B∀J:Q!=∩⊗∞>∀!1αεu~↑⊗I∧~>:M¬~N⊗:"Il4(HJ⊗:⊃Xh(&J-"VJ9∧
:N↑-⊃l4(L*:⊃lhP1∃α∃*9β∪}+MβSF)β ?}[/↔↔εK;≥β∞s⊃β∂N≠3↔Mπ##K?.;!βSF)α%>zβO↔G.+;∂∃r↓∀4(hR⊗bB∩αJV9BIl4(L∩⊗≡&ph(&BlJ:&RL
2&j*A%l4PJ∞f∞d)!%lhP&∞2⎇~∀b∩M~-!%Xh(&⊗t!l4(hRJV9BIl4(hR⊗:⊃ph(βJNu